home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gold Medal Software 3
/
Gold Medal Software - Volume 3 (Gold Medal) (1994).iso
/
windows
/
editprog
/
newvisda.arj
/
ATTACH.FRM
< prev
next >
Wrap
Text File
|
1993-04-28
|
10KB
|
384 lines
VERSION 2.00
Begin Form fAttach
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Double
Caption = "Attach Table"
ClientHeight = 3345
ClientLeft = 1455
ClientTop = 2010
ClientWidth = 7455
Height = 3750
Left = 1395
LinkTopic = "Form1"
ScaleHeight = 3345
ScaleWidth = 7455
Top = 1665
Width = 7575
Begin TextBox cDatasource
Height = 285
Left = 1995
TabIndex = 2
Tag = "OL"
Top = 945
Width = 3690
End
Begin PictureBox Picture1
BackColor = &H00FFFFFF&
Height = 3150
Left = 5775
ScaleHeight = 3120
ScaleWidth = 1560
TabIndex = 20
Tag = "OL"
Top = 120
Width = 1590
Begin OptionButton Option1
BackColor = &H00FFFFFF&
Caption = "FoxPro 2.5"
Height = 330
Index = 4
Left = 105
TabIndex = 23
Top = 1680
Width = 1380
End
Begin OptionButton Option1
BackColor = &H00FFFFFF&
Caption = "FoxPro 2.0"
Height = 330
Index = 3
Left = 120
TabIndex = 10
Top = 1365
Width = 1380
End
Begin OptionButton Option1
BackColor = &H00FFFFFF&
Caption = "dBase IV"
Height = 330
Index = 2
Left = 120
TabIndex = 9
Top = 1080
Width = 1380
End
Begin OptionButton Option1
BackColor = &H00FFFFFF&
Caption = "ODBC"
Height = 330
Index = 7
Left = 105
TabIndex = 13
Top = 2730
Width = 1380
End
Begin OptionButton Option1
BackColor = &H00FFFFFF&
Caption = "Btrieve"
Height = 330
Index = 6
Left = 105
TabIndex = 12
Top = 2370
Width = 1380
End
Begin OptionButton Option1
BackColor = &H00FFFFFF&
Caption = "Paradox 3.X"
Height = 330
Index = 5
Left = 105
TabIndex = 11
Top = 2010
Width = 1380
End
Begin OptionButton Option1
BackColor = &H00FFFFFF&
Caption = "dBase III"
Height = 330
Index = 1
Left = 105
TabIndex = 8
Top = 720
Width = 1380
End
Begin OptionButton Option1
BackColor = &H00FFFFFF&
Caption = "MS Access"
Height = 330
Index = 0
Left = 105
TabIndex = 7
Top = 420
Value = -1 'True
Width = 1380
End
Begin Label Label1
BackColor = &H00FFFFFF&
Caption = "Data Type:"
Height = 225
Index = 4
Left = 105
TabIndex = 21
Top = 105
Width = 1065
End
End
Begin TextBox cDatabase
Height = 285
Left = 1995
TabIndex = 1
Tag = "OL"
Top = 525
Width = 3690
End
Begin CheckBox cExclusive
BackColor = &H00C0C0C0&
Caption = "Open Exclusive"
Height = 225
Left = 3150
TabIndex = 6
Top = 2310
Width = 2325
End
Begin CheckBox cSavePassword
BackColor = &H00C0C0C0&
Caption = "Save Password"
Height = 225
Left = 315
TabIndex = 5
Top = 2310
Width = 2640
End
Begin CommandButton CancelBtn
Cancel = -1 'True
Caption = "&Cancel"
Height = 435
Left = 3255
TabIndex = 15
Top = 2730
Width = 1905
End
Begin CommandButton OkayBtn
Caption = "&OK"
Default = -1 'True
Enabled = 0 'False
Height = 435
Left = 630
TabIndex = 14
Top = 2730
Width = 1905
End
Begin ComboBox cTableName
Height = 300
Left = 1995
TabIndex = 4
Tag = "OL"
Top = 1785
Width = 3690
End
Begin TextBox cConnect
Height = 285
Left = 1995
TabIndex = 3
Tag = "OL"
Top = 1365
Width = 3690
End
Begin TextBox cAttachName
Height = 285
Left = 1995
TabIndex = 0
Tag = "OL"
Top = 105
Width = 3690
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "ODBC DataSource:"
Height = 225
Index = 5
Left = 105
TabIndex = 22
Top = 945
Width = 1800
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Database Name:"
Height = 225
Index = 3
Left = 105
TabIndex = 19
Top = 525
Width = 1800
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Table to Attach:"
Height = 225
Index = 2
Left = 105
TabIndex = 18
Top = 1785
Width = 1800
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Connect String:"
Height = 225
Index = 1
Left = 105
TabIndex = 17
Top = 1365
Width = 1800
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Attachment Name:"
Height = 225
Index = 0
Left = 105
TabIndex = 16
Top = 105
Width = 1800
End
End
Sub CancelBtn_Click ()
Unload Me
End Sub
Sub cAttachName_Change ()
If cAttachName <> "" Then
OkayBtn.Enabled = True
Else
OkayBtn.Enabled = False
End If
If cTableName.ListCount > 0 Then cTableName.Clear
End Sub
Sub cConnect_Change ()
If cAttachName <> "" Then
OkayBtn.Enabled = True
Else
OkayBtn.Enabled = False
End If
If cTableName.ListCount > 0 Then cTableName.Clear
End Sub
Sub cTableName_DropDown ()
Dim d As database
Dim i As Integer
Dim dt As String 'data type string
On Error GoTo DDErr
SetHourglass Me
If cTableName.ListCount = 0 Then
If Option1(0) Then
dt = ";"
ElseIf Option1(1) Then
dt = "dBASE III;"
ElseIf Option1(2) Then
dt = "dBASE IV;"
ElseIf Option1(3) Then
dt = "FoxPro 2.0;"
ElseIf Option1(4) Then
dt = "FoxPro 2.5;"
ElseIf Option1(5) Then
dt = "Paradox;"
ElseIf Option1(6) Then
dt = "Btrieve;"
ElseIf Option1(7) Then
dt = "ODBC;"
End If
If cDatabase <> "" Then
dt = dt + "database=" + cDatabase
End If
If cDatasource <> "" Then
dt = dt + ";dsn=" + cDatasource
End If
Set d = OpenDatabase("", 0, 0, dt + ";" + cConnect + ";LoginTimeout=" & glLoginTimeout)
For i = 0 To d.TableDefs.Count - 1
If (d.TableDefs(i).Attributes And DB_SYSTEMOBJECT) = 0 Then
cTableName.AddItem d.TableDefs(i).Name
End If
Next
End If
ResetMouse Me
GoTo DDEnd
DDErr:
ResetMouse Me
ShowError
Resume DDEnd
DDEnd:
End Sub
Sub Form_Paint ()
Outlines Me
End Sub
Sub OkayBtn_Click ()
On Error GoTo OKErr
Dim d As database
Dim dt As String 'data type string
Dim tbl As New TableDef
SetHourglass Me
If Option1(0) Then
dt = ";"
ElseIf Option1(1) Then
dt = "dBASE III;"
ElseIf Option1(2) Then
dt = "dBASE IV;"
ElseIf Option1(3) Then
dt = "FoxPro 2.0;"
ElseIf Option1(4) Then
dt = "FoxPro 2.5;"
ElseIf Option1(5) Then
dt = "Paradox;"
ElseIf Option1(6) Then
dt = "Btrieve;"
ElseIf Option1(7) Then
dt = "ODBC;"
End If
If cDatabase <> "" Then
dt = dt + "database=" + cDatabase
End If
If cDatasource <> "" Then
dt = dt + ";dsn=" + cDatasource
End If
'set the properties
tbl.Name = cAttachName
tbl.SourceTableName = cTableName
tbl.Connect = dt + ";" + cConnect
If cSavePassword = 1 Then
tbl.Attributes = &H20000
End If
If cExclusive = 1 Then
tbl.Attributes = tbl.Attributes + &H10000
End If
gCurrentDB.TableDefs.Append tbl
RefreshTables fTables.cTableList, True
ResetMouse Me
GoTo OKEnd
OKErr:
ResetMouse Me
ShowError
Resume OKEnd
OKEnd:
Unload Me
End Sub
